home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / t_os / mer_fnt / mer_fnt.bas next >
BASIC Source File  |  1993-11-30  |  28KB  |  752 lines
  1. 10000 '
  2. 10010 ' mer_fnt.bas    (93/01/05) - 93/08/17
  3. 10020 '     by TEMITORAVIOS
  4. 10030 '
  5. 10040 ' ２つのフォントファイルを読み込んで、指定した部分を複写するものです。
  6. 10050 ' IBM DOS/V のフォントを読み込む機能も有ります｡
  7. 10060 '
  8. 10070 CLEAR ,,,450000 '配列変数領域
  9. 10080 DEFINT A-Z
  10. 10090 F_MAX&  = 110592/2-1 'system font のサイズ
  11. 10100 FT_MAX& = 200000/2   'fontex font のサイズ
  12. 10110 DIM FT%(F_MAX&,1),DSP%(12),SEL_BK&(50,1),SEL_NM$(50)
  13. 10120 DIM TMP%(FT_MAX&):ERASE TMP%    '確保出来るかcheck
  14. 10130 '
  15. 10140 ' sjis ｺｰﾄﾞから 12ﾄﾞｯﾄﾌｫﾝﾄﾌｧｲﾙ内の 格納位置を求める バイト単位
  16. 10150 DEF FNSJAD&(N&)= 256*12 + ((INT(N&/256) - &H81)*188 + (N& MOD 256) -&H40 +((N& MOD 256)> &H7F))*24
  17. 10160 ' 2バイト chr$()
  18. 10170 DEF FNSJCH$(N&)=CHR$(INT(N&/256))+CHR$(N& MOD 256)
  19. 10180 ' 範囲表示用
  20. 10190 DEF FNHANI$(T&,B&)=" 範囲  $"+HEX$(T&)+" ("+FNSJCH$(T&)+") - $"+HEX$(B&)+ " ("+FNSJCH$(B&)+")"
  21. 10200 ' だいたいの表示範囲
  22. 10210 DEF FNADSTP(N)=-(PUT_TYPE = 0)*(20*18) + -(PUT_TYPE = 1)*(24*25) + -(PUT_TYPE = 2)*(10*11)
  23. 10220 '
  24. 10230 ' sjis コードの調整(存在しないコードをスキップ)をする
  25. 10240     DEF FNSJADJ1&(N&) = (N& -((N& MOD 256) = &H7F))*(&H40 <= (N& MOD 256))*((N& MOD 256) <= &HFC)  ' n& の下位バイトが $40 - $fc の時($7fスキップ)
  26. 10250     DEF FNSJADJ2&(N&) = (INT(N&/256)*256+&H40)*-((N& MOD 256) < &H40)     '<$40
  27. 10260     DEF FNSJADJ3&(N&) = ((INT(N&/256)+1)*256+&H40)*-((N& MOD 256) > &HFC) '>$fc
  28. 10270 DEF FNSJADJ&(N&) = FNSJADJ1&(N&) + FNSJADJ2&(N&) + FNSJADJ3&(N&)
  29. 10280 ' 存在しないコードを表示しないように｡ ( FT%(N,BUF)の宣言されてない範囲を表示参照しないように )
  30. 10290 DEF FNBTMCHK&(N&) = (&H9872 - FNADSTP(0))*-(SJ_CODE& > (&H9872 - FNADSTP(0))) + (SJ_CODE&)*-(SJ_CODE& <= (&H9872 - FNADSTP(0)))
  31. 10300 '0
  32. 10310 '
  33. 10320 I = 0
  34. 10330 READ S$: WHILE S$ <> "**"
  35. 10340     READ E$,N$
  36. 10350     SEL_BK&(I,0) = VAL("&h"+S$)
  37. 10360     SEL_BK&(I,1) = VAL("&h"+E$)
  38. 10370     SEL_NM$(I) = N$
  39. 10380     I = I + 1
  40. 10390 READ S$: WEND
  41. 10400 SEL_MAX = I
  42. 10410 '
  43. 10420 'フォント分類
  44. 10430 DATA 00,   00,    "- コード 入力 -"
  45. 10440 DATA 00,   ff,    "  ＡＮＫ文字   "
  46. 10450 DATA 8140, 81fc,  "    記   号    "
  47. 10460 DATA 824f, 8258,  "    数   字    "
  48. 10470 DATA 8260, 829a,  " アルファベット"
  49. 10480 DATA 829f, 82f2,  "  ひ ら が な  "
  50. 10490 DATA 8340, 8396,  "  カ タ カ ナ  "
  51. 10500 DATA 839f, 83d6,  " ギリシャ文字  "
  52. 10510 DATA 8440, 8491,  "  ロシア文字   "
  53. 10520 DATA 849f, 84d4,  "    罫   線    "
  54. 10530 DATA 889f, 9872,  "第一水準JIS漢字"
  55. 10540 DATA **
  56. 10550 '
  57. 10560 BUF = 0
  58. 10570 PUT_TYPE = 0
  59. 10580 PUT_BACK = 1
  60. 10590 SJ_CODE& = &H8140
  61. 10600 B_FNAME$(0) = ".\"
  62. 10610 B_FNAME$(1) = ".\"
  63. 10620 '
  64. 10630 '画面
  65. 10640 CLS
  66. 10650 CONSOLE 18,7
  67. 10660 LINE (0,  0)-STEP(319,319),PSET,7,B
  68. 10670 LINE (320,0)-STEP(319,319),PSET,7,B
  69. 10680 MENU = 1
  70. 10690 '
  71. 10700 GOSUB *FILE_READ
  72. 10710 *LOOP
  73. 10720 '
  74. 10730 IF MENU = 1 THEN
  75. 10740     LINE (2 + BUF     *320,2)-STEP(316,319-4),PSET,4,B
  76. 10750     LINE (2 + -(BUF=0)*320,2)-STEP(316,319-4),PSET,0,B '反対側カーソル消す
  77. 10760     COLOR 15 '反転表示
  78. 10770       LOCATE BUF*40,17
  79. 10780       PRINT B_FNAME$(BUF);
  80. 10790     COLOR 7
  81. 10800       LOCATE -(BUF = 0)*40,17
  82. 10810       PRINT B_FNAME$(ABS(1-BUF));
  83. 10820     '
  84. 10830     CLS 1 'スクロール領域
  85. 10840     PRINT "   ０ .. 表示選択   ↑,↓.. 表示切替      ←,→.. バッファ切替"
  86. 10850     PRINT ""
  87. 10860     PRINT "   １ .. 複写      ４ .. 読み込み          ＊ .. 表示形式    ／ .. 枠表示"
  88. 10870     PRINT "   ２ .. 消去      ５ .. 書き込み          ＋ .. 再表示      － .. 表示中断"
  89. 10880     PRINT "                   ６ .. DOS/V font 読込   ＝ .. 表示範囲を左右あわせる"
  90. 10890     PRINT "   ９ .. 終了"
  91. 10900     MENU = 0
  92. 10910 ENDIF
  93. 10920 '
  94. 10930 I$ = INPUT$(1)
  95. 10940 IF I$ = "0" THEN
  96. 10950     GOSUB *CODE_SEL
  97. 10960 ELSE IF I$ = "1" THEN
  98. 10970     GOSUB *CODE_COPY
  99. 10980 ELSE IF I$ = "2" THEN
  100. 10990     GOSUB *CODE_CLR
  101. 11000 'ELSE IF I$ = "3" THEN
  102. 11010 '    GOSUB *CODE_EFFECT
  103. 11020 ELSE IF I$ = "4" THEN
  104. 11030     GOSUB *FILE_READ
  105. 11040 ELSE IF I$ = "5" THEN
  106. 11050     GOSUB *FILE_WRITE
  107. 11060 ELSE IF I$ = "6" THEN
  108. 11070     GOSUB *FONTEX_READ
  109. 11080 ELSE IF I$ = "9" THEN
  110. 11090     GOSUB *EXIT
  111. 11100 ELSE IF I$ = "*" THEN
  112. 11110     GOSUB *TYPE_CHANGE
  113. 11120 ELSE IF I$ = "/" THEN
  114. 11130     GOSUB *BACK_CHANGE
  115. 11140 ELSE IF I$ = "+" THEN
  116. 11150     GOSUB *BUF_REF
  117. 11160 ELSE IF I$ = "=" THEN
  118. 11170     GOSUB *BUF_REF_2
  119. 11180 ELSE IF I$ = CHR$(&H1E) THEN  'up_ar
  120. 11190     GOSUB *UP_PAGE
  121. 11200 ELSE IF I$ = CHR$(&H1F) THEN  'down_ar
  122. 11210     GOSUB *DOWN_PAGE
  123. 11220 ELSE IF I$ = CHR$(&H1C) THEN  'right_ar
  124. 11230     GOSUB *BUF_CHANGE
  125. 11240 ELSE IF I$ = CHR$(&H1D) THEN  'left_ar
  126. 11250     GOSUB *BUF_CHANGE
  127. 11260 ELSE IF I$ = CHR$(&H14) THEN  'ctrl+T
  128. 11270     GOSUB *TEM_FNT
  129. 11280 ENDIF
  130. 11290 GOTO *LOOP
  131. 11300 '
  132. 11310 END
  133. 11320 '----処理ルーチン---------------------------------------
  134. 11330 *CODE_SEL
  135. 11340     '表示先頭を選ぶ｡
  136. 11350     CLS 1
  137. 11360     PRINT "＝＝　表示選択　＝＝"
  138. 11370     PRINT "どの種類から？  ← → 選択   (↑表示 , RET決定)"
  139. 11380     SEL_BNK = 0: SEL_CSR = 2 '全角から
  140. 11390     GOSUB *SEL_AR
  141. 11400     SJ_CODE& = SEL_OUT&
  142. 11410     SJ_CODE& = FNBTMCHK&(SJ_CODE&)      ' : BUF_PUT = 1
  143. 11420     GOSUB *FNT_PUT
  144. 11430     MENU = 1
  145. 11440     RETURN
  146. 11450 '
  147. 11460 *CODE_COPY
  148. 11470     '指定した部分を反対のバッファに複写する
  149. 11480     GOSUB *SEL_CODE
  150. 11490     BUF = -(BUF = 0) '相手側フォント表示
  151. 11500     GOSUB *FNT_PUT   '
  152. 11510     BUF = -(BUF = 0) '
  153. 11520     '複写方向の確認
  154. 11530     PRINT "＝＝  フォント複写　＝＝"
  155. 11540     PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
  156. 11550     IF BUF = 0 THEN
  157. 11560         PRINT "["+B_FNAME$(0)+"]  →  ["+B_FNAME$(1)+"] の方向に複写します｡"
  158. 11570     ELSE
  159. 11580         PRINT "["+B_FNAME$(0)+"]  ←  ["+B_FNAME$(1)+"] の方向に複写します｡"
  160. 11590     ENDIF
  161. 11600     PRINT "        [RET] 実行       [ESC] 取消"
  162. 11610     WAIT 10:WHILE INKEY$ <> "":WEND
  163. 11620     IF INPUT$(1) <> CHR$(13) THEN
  164. 11630         GOTO *CODE_COPY_T
  165. 11640     ENDIF
  166. 11650     PRINT "    -- 処理中 --"
  167. 11660     IF (SEL_BTM& < 256) THEN        '半角コード
  168. 11670         FOR I = SEL_TOP&*6  TO  SEL_BTM&*6+5
  169. 11680             FT%(I,-(BUF=0)) = FT%(I,BUF)
  170. 11690         NEXT
  171. 11700     ELSE                            '全角コード
  172. 11710         FOR I! = FNSJAD&(SEL_TOP&)/2 TO FNSJAD&(SEL_BTM&)/2+11
  173. 11720             FT%(I!,-(BUF=0)) = FT%(I!,BUF)
  174. 11730         NEXT
  175. 11740     ENDIF
  176. 11750     BUF = -(BUF = 0) '相手側のみ表示
  177. 11760     BUF_PUT = 1
  178. 11770     GOSUB *FNT_PUT
  179. 11780     BUF = -(BUF = 0)
  180. 11790 *CODE_COPY_T
  181. 11800     MENU = 1
  182. 11810     RETURN
  183. 11820 '
  184. 11830 *CODE_CLR
  185. 11840     '表示されない部分に入ったゴミを消す｡ FNTMAKEで気になったもので..
  186. 11850     GOSUB *SEL_CODE
  187. 11860     PRINT "＝＝  フォント消去　＝＝"
  188. 11870     PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
  189. 11880     PRINT "        [RET] 実行       [ESC] 取消"
  190. 11890     WAIT 10:WHILE INKEY$ <> "":WEND
  191. 11900     IF INPUT$(1) <> CHR$(13) THEN
  192. 11910         GOTO *CODE_CLR_T              '中止
  193. 11920     ENDIF
  194. 11930     PRINT "    -- 処理中 --"
  195. 11940     IF (SEL_BTM& < 256) THEN        '半角コード
  196. 11950         FOR I = SEL_TOP&*6  TO  SEL_BTM&*6+5
  197. 11960             FT%(I,BUF) = 0
  198. 11970         NEXT
  199. 11980     ELSE                            '全角コード
  200. 11990         FOR I! = FNSJAD&(SEL_TOP&)/2 TO FNSJAD&(SEL_BTM&)/2+11
  201. 12000             FT%(I!,BUF) = 0
  202. 12010         NEXT
  203. 12020     ENDIF
  204. 12030     BUF_PUT = 1
  205. 12040     GOSUB *FNT_PUT
  206. 12050 *CODE_CLR_T
  207. 12060     MENU = 1
  208. 12070     RETURN
  209. 12080 '
  210. 12090 *CODE_EFFECT
  211. 12100 ' 0-3 , 8-11 の部分のみ太くする
  212. 12110 '  12x12ではさすがに苦しい (もともとは98のゲームで見た表示)のと、
  213. 12120 '  動作がおかしいのでメニューから外す｡
  214. 12130     GOSUB *SEL_CODE
  215. 12140     PRINT "＝＝  フォント変形　＝＝"
  216. 12150     PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
  217. 12160     PRINT "        [RET] 実行       [ESC] 取消"
  218. 12170     WAIT 10:WHILE INKEY$ <> "":WEND
  219. 12180     IF INPUT$(1) <> CHR$(13) THEN
  220. 12190         GOTO *CODE_EFFECT_T '中止
  221. 12200     ENDIF
  222. 12210     PRINT "    -- 処理中 --"
  223. 12220     IF (SEL_BTM& < 256) THEN        '半角コード
  224. 12230         FOR I! = SEL_TOP&*6  TO   SEL_BTM&*6+5  STEP 6
  225. 12240             FOR J = 0 TO 11
  226. 12250                 IF J <=3 OR 8 <= J THEN
  227. 12260                     D = PEEK(VARPTR(FT%(I!,BUF))+J)
  228. 12270                     POKE VARPTR(FT%(I!,BUF))+J, (D OR INT(D/2)) AND &HFC
  229. 12280                 ENDIF
  230. 12290             NEXT
  231. 12300         NEXT
  232. 12310     ELSE                            '全角コード
  233. 12320         FOR I! = 0 TO (FNSJAD&(SEL_BTM&) - FNSJAD&(SEL_TOP&))/2  STEP 12
  234. 12330             FOR J = 0 TO 11
  235. 12340                 IF J <=3 OR 8 <= J THEN
  236. 12350                     AD& = FNSJAD&(SEL_TOP&)/2 + I! + J
  237. 12360                     D = FT%(AD&,BUF)
  238. 12370                     FT%(AD&,BUF) = D OR INT(D / 2) AND &HFFF0
  239. 12380                 ENDIF
  240. 12390             NEXT
  241. 12400         NEXT
  242. 12410     ENDIF
  243. 12420     BUF_PUT = 1
  244. 12430     GOSUB *FNT_PUT
  245. 12440 *CODE_EFFECT_T
  246. 12450     MENU = 1
  247. 12460     RETURN
  248. 12470 '
  249. 12480 *FILE_READ
  250. 12490     CLS 1
  251. 12500     PRINT "＝＝  フォントファイル読み込み　＝＝"
  252. 12510     OLD_NAME$ = B_FNAME$(BUF)
  253. 12520     WILD$ = "*.fnt"
  254. 12530     RD_WT = 0
  255. 12540     GOSUB *FILE_NAME
  256. 12550     IF FL_NAME$ = "-" THEN GOTO *FILE_READ_T   '中止
  257. 12560     B_FNAME$(BUF) = FL_NAME$
  258. 12570     PRINT "    -- 処理中 --"
  259. 12580     DIM TMP%(F_MAX&) '直接必要な位置に読み出せないため
  260. 12590     'ファイル名を入力するルーチンでファイルがある事を確認している
  261. 12600     LOAD@ FL_NAME$,TMP%
  262. 12610     FOR I! = 0 TO F_MAX&
  263. 12620         FT%(I!,BUF) = TMP%(I!)
  264. 12630     NEXT
  265. 12640     ERASE TMP%
  266. 12650     BUF_PUT = 1
  267. 12660     GOSUB *FNT_PUT
  268. 12670 *FILE_READ_T
  269. 12680     MENU = 1
  270. 12690     RETURN
  271. 12700 '
  272. 12710 *FILE_WRITE
  273. 12720     CLS 1
  274. 12730     PRINT "＝＝  フォントファイル書き込み　＝＝"
  275. 12740     OLD_NAME$ = B_FNAME$(BUF)
  276. 12750     WILD$ = "*.fnt"
  277. 12760     RD_WT = 1
  278. 12770     GOSUB *FILE_NAME
  279. 12780     IF FL_NAME$ = "-" THEN GOTO *FILE_WRITE_T   '中止
  280. 12790     B_FNAME$(BUF) = FL_NAME$
  281. 12800     PRINT "    -- 処理中 --"
  282. 12810     DIM TMP%(F_MAX&)  'ファイルサイズを合わせる為に配列を用意する
  283. 12820     FOR I! = 0 TO F_MAX&
  284. 12830         TMP%(I!) = FT%(I!,BUF)
  285. 12840     NEXT
  286. 12850     'ファイル名を入力する部分で 同名のファイルは .BAK に変更されている
  287. 12860     SAVE@ FL_NAME$,TMP%
  288. 12870     ERASE TMP%
  289. 12880 *FILE_WRITE_T
  290. 12890     MENU = 1
  291. 12900     RETURN
  292. 12910 '
  293. 12920 *FONTEX_READ
  294. 12930     ' DOS/V 用フォントを読み込む
  295. 12940     CLS 1
  296. 12950     PRINT "＝＝  ＤＯＳ／Ｖフォント　読み込み　＝＝"
  297. 12960     OLD_NAME$ = "-"
  298. 12970     WILD$ = "*.*"
  299. 12980     RD_WT = 0
  300. 12990     GOSUB *FILE_NAME
  301. 13000     IF FL_NAME$ = "-" THEN GOTO *FONTEX_READ_T
  302. 13010     DIM TMP%(FT_MAX&)
  303. 13020 'メモリに入り切らない時は FT_MAX&を 増やす
  304. 13030     LOAD@ FL_NAME$,TMP%
  305. 13040 '
  306. 13050 ' フォントデータが 1バイトずれているので 配列変数では扱えず､peek,poke で処理している
  307. 13060     KN_AD& = VARPTR(TMP%(0))  'DOS/V フォントデータ先頭
  308. 13070     ' ID check
  309. 13080     I$ = ""
  310. 13090     FOR I = 0 TO 5
  311. 13100         I$ = I$ + CHR$(PEEK(KN_AD&+I))
  312. 13110     NEXT
  313. 13120     IF I$ <> "FONTX2" THEN
  314. 13130         PRINT "FONTEX用 font ではありません｡ [hit any key]"
  315. 13140         I$ = INPUT$(1)
  316. 13150         GOTO *NOT_FONTEX
  317. 13160     ENDIF
  318. 13170     I$ = ""
  319. 13180     ' font name print
  320. 13190     FOR I = 6 TO 13
  321. 13200         I$ = I$ + CHR$(PEEK(KN_AD&+I))
  322. 13210     NEXT
  323. 13220     PRINT "FONT NAME =" + I$
  324. 13230 '
  325. 13240     IF PEEK(KN_AD& +16) = 0 THEN '半角フォント?
  326. 13250 ' -- 半角フォント 処理 --
  327. 13260         F_TYPE = 0
  328. 13270         PRINT "半角のフォントデータです｡"
  329. 13280         IF PEEK(KN_AD& +14) <> 6 OR PEEK(KN_AD& +15) <> 12 THEN
  330. 13290             PRINT "フォントサイズが違います｡ (";PEEK(KN_AD&+14);"x";PEEK(KN_AD& +15);") [hit any key]"
  331. 13300             I$ = INPUT$(1)
  332. 13310             GOTO *NOT_FONTEX
  333. 13320         ENDIF
  334. 13330         '半角 合成    アドレスを合わせて書き移すだけ
  335. 13340         TW_AD& = VARPTR(FT%(0,BUF)) 
  336. 13350         KN_AD& = VARPTR(TMP%(0))+17
  337. 13360         FOR I = 1 TO 256*12
  338. 13370             POKE TW_AD&,PEEK(KN_AD&)
  339. 13380             TW_AD& = TW_AD& + 1
  340. 13390             KN_AD& = KN_AD& + 1
  341. 13400         NEXT
  342. 13410     ELSE IF PEEK(KN_AD& +16) = 1 THEN '全角フォント?
  343. 13420 ' -- 全角フォント 処理 --
  344. 13430         F_TYPE = 1
  345. 13440         PRINT "全角のフォントデータです｡"
  346. 13450         IF PEEK(KN_AD& +14) <> 12 OR PEEK(KN_AD& +15) <> 12 THEN
  347. 13460             PRINT "フォントサイズが違います｡ (";PEEK(KN_AD&+14);"x";PEEK(KN_AD& +15);") [hit any key]"
  348. 13470             I$ = INPUT$(1)
  349. 13480             GOTO *NOT_FONTEX
  350. 13490         ENDIF
  351. 13500 '
  352. 13510         KN_TB& = VARPTR(TMP%(0))+18  '領域テーブル先頭
  353. 13520         KN_TBN = PEEK(KN_TB& -1)     '領域テーブルのサイズ (と言うより個数)
  354. 13530         KN_FD& = KN_TB& + KN_TBN*4   'フォントデータ先頭
  355. 13540         AD& = VARPTR(FT%(0,BUF))     '複写先計算用
  356. 13550 '
  357. 13560         FOR I = 1 TO KN_TBN
  358. 13570             KN_ST& = PEEK(KN_TB& + 1)*256 + PEEK(KN_TB&)     'フォント範囲の始り (sjis)
  359. 13580             KN_ED& = PEEK(KN_TB& + 3)*256 + PEEK(KN_TB& + 2) 'フォント範囲の終わり
  360. 13590             KN_TB& = KN_TB& + 4
  361. 13600             IF KN_ST& > &H9872 THEN     '第２水準が出たら打切り
  362. 13610                 I = KN_TBN
  363. 13620     '全角と違い表示個数が同じなので同ルーチンで処理
  364. 13630             ELSE                        '第１水準ならば処理
  365. 13640                 PRINT CHR$(13)+FNHANI$(KN_ST&,KN_ED&)+"  処理中";  '処理範囲表示
  366. 13650                 FOR J = 0  TO  KN_ED& - KN_ST&
  367. 13660                     ' sjis コードを フォントファイルのアドレスに変換
  368. 13670                     TW_AD& = AD& + FNSJAD&(J + KN_ST&)   '書き移し先のアドレス
  369. 13680                     FOR K = 1 TO 2*12                    'フォントのバイト数書き移す
  370. 13690                         POKE  TW_AD& , PEEK(KN_FD&)
  371. 13700                         TW_AD& = TW_AD& + 1
  372. 13710                         KN_FD& = KN_FD& + 1
  373. 13720                     NEXT
  374. 13730                 NEXT
  375. 13740             ENDIF
  376. 13750         NEXT
  377. 13760     ENDIF
  378. 13770     '読み込んだ種類の文字を表示
  379. 13780     IF F_TYPE = 0 THEN
  380. 13790         SJ_CODE& = 0                               '半角文字
  381. 13800     ELSE
  382. 13810         IF SJ_CODE& < 256 THEN SJ_CODE& = &H8140   '全角文字
  383. 13820     ENDIF
  384. 13830     GOSUB *FNT_PUT
  385. 13840 *NOT_FONTEX
  386. 13850     ERASE TMP%
  387. 13860 *FONTEX_READ_T
  388. 13870     MENU = 1
  389. 13880     RETURN
  390. 13890 '
  391. 13900 *EXIT
  392. 13910     CLS 1
  393. 13920     PRINT "＝＝　終了　＝＝"
  394. 13930     PRINT 
  395. 13940     PRINT "    ＭＥＲ＿ＦＮＴ を 終了します｡"
  396. 13950     PRINT 
  397. 13960     PRINT "        [RET] 実行       [ESC] 取消"
  398. 13970     WAIT 10:WHILE INKEY$ <> "":WEND
  399. 13980     IF INPUT$(1) <> CHR$(13) THEN
  400. 13990         MENU = 1
  401. 14000         RETURN
  402. 14010     ENDIF
  403. 14020     SYSTEM
  404. 14030     END
  405. 14040 '
  406. 14050 *UP_PAGE
  407. 14060     ' 表示範囲をずらす
  408. 14070     AD& = FNADSTP(0)                     '表示形式によって増加する量を変化させる
  409. 14080     SJ_CODE& = FNSJADJ&(SJ_CODE& - AD&)  '存在しないコードをスキップ
  410. 14090     IF SJ_CODE& < &H8140 THEN SJ_CODE& = &H8140   'sjis コードの範囲?
  411. 14100     GOSUB *FNT_PUT
  412. 14110     RETURN
  413. 14120 '
  414. 14130 *DOWN_PAGE
  415. 14140     ' 表示範囲をずらす
  416. 14150     AD& = FNADSTP(0)
  417. 14160     SJ_CODE& = FNSJADJ&(SJ_CODE& + AD&)
  418. 14170     SJ_CODE& = FNBTMCHK&(SJ_CODE&)       '第一水準のフォントまでしか表示しないように
  419. 14180     GOSUB *FNT_PUT
  420. 14190     RETURN
  421. 14200 '
  422. 14210 *BUF_CHANGE
  423. 14220     ' 反対側のバッファに移る
  424. 14230     BUF = -(BUF = 0)
  425. 14240     SJ_CODE& = BUF_TOP&(BUF)
  426. 14250     GOSUB *FNT_PUT
  427. 14260     MENU = 1
  428. 14270     RETURN
  429. 14280 '
  430. 14290 *TYPE_CHANGE
  431. 14300     ' フォントの表示タイプを 変更する
  432. 14310     PUT_TYPE = PUT_TYPE +1
  433. 14320     IF PUT_TYPE > 2 THEN PUT_TYPE = 0
  434. 14330     BUF_PUT = 1     'BUF_TOP&(0) = -1 : BUF_TOP&(1) = -1
  435. 14340     GOSUB *FNT_PUT
  436. 14350     RETURN
  437. 14360 '
  438. 14370 *BACK_CHANGE
  439. 14380     ' フォント表示の枠を付けるかのスイッチ変更
  440. 14390     PUT_BACK = -(PUT_BACK = 0)
  441. 14400     BUF_PUT = 1
  442. 14410     GOSUB *FNT_PUT
  443. 14420     RETURN
  444. 14430 '
  445. 14440 *BUF_REF
  446. 14450     ' バッファの再表示 (中断したときの為)
  447. 14460     BUF_PUT = 1
  448. 14470     GOSUB *FNT_PUT
  449. 14480     RETURN
  450. 14490 '
  451. 14500 *BUF_REF_2
  452. 14510     ' 反対のバッファの表示先頭を揃える
  453. 14520     'BUF_PUT = 1
  454. 14530     'GOSUB *FNT_PUT
  455. 14540     BUF = -(BUF = 0)
  456. 14550     GOSUB *FNT_PUT
  457. 14560     BUF = -(BUF = 0)
  458. 14570     RETURN
  459. 14580 '
  460. 14590 *TEM_FNT
  461. 14600     ' オリジナルフォント読み込み
  462. 14610     FL_NAME$ = "tem_ita.fnt"  'TEMITORAVIOS ｵﾘｼﾞﾅﾙ の ｲﾀﾘｯｸ もどき font の意味
  463. 14620     GOSUB *FL_EXIST
  464. 14630     IF FL_EXIST = 0 THEN
  465. 14640         PRINT "TEM_ITA.FNT が カレントディレクトリに見つかりません｡ (Hit any key.)"
  466. 14650         I$ = INPUT$(1)
  467. 14660         GOTO *TEM_FNT_T
  468. 14670     ENDIF
  469. 14680     DIM TMP%(6*16*6)
  470. 14690     LOAD@ "tem_ita.fnt",TMP%
  471. 14700     FOR I = &H20*6 TO &H7F*6+5
  472. 14710         FT%(I,BUF) = TMP%(I - &H20*6)
  473. 14720     NEXT
  474. 14730     ERASE TMP%
  475. 14740     SJ_CODE& = 0:BUF_PUT = 1
  476. 14750     GOSUB *FNT_PUT
  477. 14760 *TEM_FNT_T
  478. 14770     MENU = 1
  479. 14780     RETURN
  480. 14790 '
  481. 14800 '----サブルーチン---------------------------------------
  482. 14810 '---- ファイル名入力 ----
  483. 14820 *FILE_NAME
  484. 14830 'in old_name$ , wild$ ,rd_wt     out fl_name$
  485. 14840 '
  486. 14850 *FILE_NAME2
  487. 14860     PRINT "ファイル名を入力してください｡ (省略時["+OLD_NAME$+"]  `-' .. 中止)"
  488. 14870     PRINT "ファイル名 >";
  489. 14880     LINE INPUT FL_NAME$
  490. 14890     IF FL_NAME$ = "" THEN FL_NAME$ = OLD_NAME$
  491. 14900     IF FL_NAME$ = "-" OR FL_NAME$ = " " THEN
  492. 14910         FL_NAME$ = "-"
  493. 14920         GOTO *FILE_NAME_T        '中止
  494. 14930     ENDIF
  495. 14940     IF MID$(FL_NAME$,LEN(FL_NAME$)) = "\" THEN '終わりが '\' のとき files
  496. 14950          FILES FL_NAME$+WILD$
  497. 14960          LOCATE 0,CSRLIN -1
  498. 14970          PRINT CHR$(13)+"                                                     "+CHR$(13);
  499. 14980          LOCATE 0,CSRLIN -1
  500. 14990          PRINT CHR$(13)+"                                                     "+CHR$(13);
  501. 15000          GOTO *FILE_NAME2
  502. 15010     ENDIF
  503. 15020     'ファイルの存在確認
  504. 15030     ER = 0
  505. 15040     GOSUB *FL_EXIST
  506. 15050     IF RD_WT = 0 THEN      'ファイルリードの時ファイルが有ることを確認
  507. 15060         IF FL_EXIST = 0 THEN
  508. 15070             PRINT "ファイルがみつかりません｡ "
  509. 15080             GOTO *FILE_NAME2    '再入力
  510. 15090         ENDIF
  511. 15100     ELSE IF RD_WT = 1 THEN      'ファイルライトの時
  512. 15110         IF FL_EXIST = 1 THEN    '同名のファイルがある時バックアップファイルを作る
  513. 15120             FL_BAK$ = FL_NAME$
  514. 15130             I = INSTR(FL_NAME$,".") '拡張子付けない馬鹿もいないだろう。
  515. 15140             FL_BAK$ = MID$(FL_BAK$,1,I-1)+".bak"
  516. 15150             ON ERROR GOTO *FL_SKIP
  517. 15160                 KILL FL_BAK$
  518. 15170             ON ERROR GOTO 0
  519. 15180             NAME FL_NAME$ AS FL_BAK$
  520. 15190         ENDIF
  521. 15200     ENDIF
  522. 15210 *FILE_NAME_T
  523. 15220     RETURN
  524. 15230 '
  525. 15240 *FL_EXIST
  526. 15250     'in fl_name$      out fl_exist    1 ..ファイルあり  0 .. ファイルなし
  527. 15260     FL_EXIST = 1
  528. 15270     ON ERROR GOTO *FL_NOT_EXIST
  529. 15280         OPEN "I",#1,FL_NAME$
  530. 15290         CLOSE (1)
  531. 15300 *FL_EXIST2
  532. 15310     ON ERROR GOTO 0
  533. 15320     RETURN
  534. 15330 *FL_NOT_EXIST
  535. 15340     FL_EXIST = 0
  536. 15350     RESUME *FL_EXIST2
  537. 15360 '
  538. 15370 *FL_SKIP 'kill fileのスキップ
  539. 15380     RESUME NEXT
  540. 15390 '
  541. 15400 '---- フォント表示 ----
  542. 15410 *FNT_PUT
  543. 15420 ' in  sj_code& put_type put_back buf
  544. 15430     IF SJ_CODE& <> BUF_TOP&(BUF) OR BUF_PUT = 1 THEN
  545. 15440         LINE (320*BUF+3,3)-STEP(319-3*2,319-3*2),PSET,0,BF
  546. 15450         IF SJ_CODE& < 256 THEN
  547. 15460             GOSUB *FNT_ANK
  548. 15470         ELSE
  549. 15480             ' 最後尾の表示位置を補正 (dim ft%(n,buf)の宣言より後ろを参照しないように)
  550. 15490             SJ_CODE& = FNBTMCHK&(SJ_CODE&)
  551. 15500             GOSUB *FNT_SJIS
  552. 15510         ENDIF
  553. 15520     ENDIF
  554. 15530     BUF_PUT = 0
  555. 15540     BUF_TOP&(BUF) = SJ_CODE&
  556. 15550     RETURN
  557. 15560 '
  558. 15570 *FNT_SJIS
  559. 15580     IF SJ_CODE& < &H8140 THEN SJ_CODE& = &H8140
  560. 15590     'SJ_CODE& = FNSJADJ&(SJ_CODE&)
  561. 15600     'LINE (320*BUF+3,10)-STEP(319-3*2,299-3*2),PSET,0,BF
  562. 15610     OFX = 15+320*BUF
  563. 15620     OFY = 10+3
  564. 15630     DC& = SJ_CODE&
  565. 15640 ' -- 2ドット 空きを付けて 表示 --
  566. 15650     IF PUT_TYPE = 0 THEN
  567. 15660         FOR I = 0 TO 15
  568. 15670              SYMBOL (OFX + 6*6 + I*14,OFY)," "+HEX$(I),12/16,12/16
  569. 15680         NEXT
  570. 15690         FOR Y = 1 TO 20
  571. 15700             SYMBOL (OFX, OFY + Y*14),HEX$(DC&)+":",12/16,12/16
  572. 15710             FOR X = 0 TO 15
  573. 15720                 DX = OFX + X*14 + 6*6
  574. 15730                 DY = OFY + Y*14
  575. 15740                 GOSUB *FNT_SJIS_SUB
  576. 15750                 ODC& = DC&
  577. 15760                 DC& = FNSJADJ&(DC&+1)
  578. 15770                 IF ODC& +1 <> DC& THEN X = 15
  579. 15780             NEXT
  580. 15790             I$ = INKEY$
  581. 15800             IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 20   '表示中断
  582. 15810         NEXT
  583. 15820 ' -- 空きなし表示 --
  584. 15830     ELSE IF PUT_TYPE = 1 THEN
  585. 15840         FOR Y = 0 TO 23
  586. 15850             SYMBOL (OFX, OFY + Y*12),HEX$(DC&)+":",12/16,12/16
  587. 15860             FOR X = 0 TO 20
  588. 15870                 DX = OFX + X*12 + 6*6
  589. 15880                 DY = OFY + Y*12
  590. 15890                 GOSUB *FNT_SJIS_SUB
  591. 15900                 ODC& = DC&
  592. 15910                 DC& = FNSJADJ&(DC&+1)
  593. 15920                 IF ODC& +1 <> DC& THEN X = 20
  594. 15930             NEXT
  595. 15940             I$ = INKEY$
  596. 15950             IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 23   '表示中断
  597. 15960         NEXT
  598. 15970 ' -- sjis code, 16x16 font と共に表示 --
  599. 15980     ELSE IF PUT_TYPE = 2 THEN
  600. 15990         FOR Y = 0 TO 10
  601. 16000             FOR X = 0 TO 9
  602. 16010                 DX = OFX + X*30
  603. 16020                 DY = OFY + Y*26
  604. 16030                 GOSUB *FNT_SJIS_SUB
  605. 16040                 IF PUT_BACK <> 0 THEN
  606. 16050                     LINE (DX+12,DY)-STEP(15,15),PSET,2,BF
  607. 16060                 ENDIF
  608. 16070                 SYMBOL (DX+12,DY),FNSJCH$(DC&),1,1         '16x16 font
  609. 16080                 SYMBOL (DX,   DY+16),HEX$(DC&),10/16,9/16   'sjis code
  610. 16090                 DC& = FNSJADJ&(DC& + 1)
  611. 16100             NEXT
  612. 16110             I$ = INKEY$
  613. 16120             IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 20   '表示中断
  614. 16130         NEXT
  615. 16140     ELSE
  616. 16150         PRINT "**error put_type "
  617. 16160     ENDIF
  618. 16170     RETURN
  619. 16180 '
  620. 16190 *FNT_SJIS_SUB
  621. 16200     ' in   dc,dx,dy
  622. 16210 ' -- 12x12 全角フォント表示用サブ --
  623. 16220     AD& = FNSJAD&(DC&)/2
  624. 16230     FOR I = 0 TO 11
  625. 16240         DSP%(I) = FT%(AD& + I,BUF) 'font data から 抜き出す
  626. 16250     NEXT
  627. 16260     IF PUT_BACK <> 0 THEN
  628. 16270         LINE (DX,DY)-STEP(11,11),PSET,1,BF
  629. 16280     ENDIF
  630. 16290     PUT@(DX,DY)-(DX+11,DY+11),DSP%
  631. 16300     RETURN
  632. 16310 '
  633. 16320 *FNT_ANK
  634. 16330 ' -- 6x12 半角フォント表示用 --
  635. 16340     LINE (10+320*BUF,10)-STEP(299,299),PSET,0,BF
  636. 16350     ST_X = (PUT_TYPE = 0)*-9  + (PUT_TYPE = 1)*-6  + (PUT_TYPE = 2)*-16   '表示間隔
  637. 16360     ST_Y = (PUT_TYPE = 0)*-15 + (PUT_TYPE = 1)*-12 + (PUT_TYPE = 2)*-18   '
  638. 16370     OF_X = 10+320*BUF
  639. 16380     OF_Y = 12
  640. 16390     'SYMBOL (OF_X+20,OFY),"0 1 2 3 4 5 6 7 8 9 A B C D E F",1,1
  641. 16400     FOR I = 0 TO 15
  642. 16410         SYMBOL(OF_X,OF_Y+(I+1)*ST_Y),HEX$(I)+"0",12/16,12/16 '縦
  643. 16420         SYMBOL(OF_X+20+ST_X*I,OFY),HEX$(I),12/16,12/16  '横
  644. 16430     NEXT
  645. 16440     FOR Y = 0 TO 15
  646. 16450         FOR X = 0 TO 15
  647. 16460             IF PUT_BACK <> 0 THEN
  648. 16470                 LINE (OF_X+20+X*ST_X,OF_Y+(Y+1)*ST_Y)-STEP(5,12),PSET,1,BF
  649. 16480             ENDIF
  650. 16490             FOR I = 0 TO 5
  651. 16500                 DSP%(I) = FT%((Y*16+X)*6+I,BUF)
  652. 16510             NEXT
  653. 16520             PUT@ (OF_X+20+X*ST_X,OF_Y+(Y+1)*ST_Y)-(OF_X+20+X*ST_X+5,OF_Y+(Y+1)*ST_Y+11),DSP%
  654. 16530             IF PUT_TYPE = 2 THEN             ' 8x16 font 表示
  655. 16540                 IF PUT_BACK <> 0 THEN
  656. 16550                      LINE (OF_X+26+X*ST_X,OF_Y+(Y+1)*ST_Y)-STEP(7,15),PSET,2,BF
  657. 16560                 ENDIF
  658. 16570                 I = Y*16+X
  659. 16580                 IF I < &H7F OR (&HA0 <= I AND I <= &HDF) THEN
  660. 16590                     SYMBOL (OF_X+26+X*ST_X,OF_Y+(Y+1)*ST_Y),CHR$(I),1,1,7
  661. 16600                 ENDIF
  662. 16610             ENDIF
  663. 16620         NEXT
  664. 16630         I$ = INKEY$
  665. 16640         IF I$ = " " OR I$ = "-" OR I$ = CHR$(&H1F) THEN Y = 15   '表示中断
  666. 16650     NEXT
  667. 16660     RETURN
  668. 16670 '
  669. 16680 '---- コード選択 ----
  670. 16690 *SEL_CODE
  671. 16700     '処理範囲指定用
  672. 16710     CLS 1
  673. 16720     PRINT
  674. 16730     PRINT "どの種類から？  ← → 選択   (↑表示 , RET決定)"
  675. 16740     SEL_BNK = 0: SEL_CSR = 2 '全角から選択始め
  676. 16750     GOSUB *SEL_AR
  677. 16760     SEL_TOP& = SEL_OUT&
  678. 16770     PRINT "どの種類まで？  ← → 選択   (↑表示 , RET決定)"
  679. 16780     SEL_BNK = 1 'コードの終わり側
  680. 16790     GOSUB *SEL_AR
  681. 16800     SEL_BTM& = SEL_OUT&
  682. 16810 'sel_top < sel_btm の確認
  683. 16820     IF SEL_TOP& > SEL_BTM& THEN
  684. 16830         SWAP SEL_TOP&,SEL_BTM&
  685. 16840     ENDIF
  686. 16850 'ank sjisに跨がらないこと
  687. 16860     IF SEL_TOP& < 256 AND SEL_BTM& => &H8140 THEN
  688. 16870         PRINT "ＡＮＫ 全角文字にまたがる指定は出来ません｡(any key)"
  689. 16880         I$ = INPUT$(1)
  690. 16890         GOTO *SEL_CODE '再入力
  691. 16900     ENDIF
  692. 16910     CLS 1
  693. 16920     SJ_CODE& = SEL_TOP&  '選択した頭を表示
  694. 16930     GOSUB *FNT_PUT
  695. 16940     RETURN
  696. 16950 '
  697. 16960 'カ－ソルの左右で 範囲を選択
  698. 16970 *SEL_AR
  699. 16980     I$ = ""
  700. 16990     WHILE I$ <> CHR$(13)
  701. 17000         PRINT USING CHR$(13)+"  ## [&             &]  ($&  &)";SEL_CSR;SEL_NM$(SEL_CSR);HEX$(SEL_BK&(SEL_CSR,SEL_BNK));
  702. 17010         I$ = INKEY$
  703. 17020         IF I$ = CHR$(&H1C) OR I$ = "6" THEN                  ' right-ar "6"
  704. 17030             SEL_CSR = SEL_CSR + 1
  705. 17040             IF SEL_CSR > SEL_MAX-1 THEN SEL_CSR = 0
  706. 17050         ELSE IF I$ = CHR$(&H1D) OR I$ = "4" THEN             ' left-ar "4"
  707. 17060             SEL_CSR = SEL_CSR - 1
  708. 17070             IF SEL_CSR < 0 THEN SEL_CSR = SEL_MAX -1
  709. 17080         ELSE IF I$ = CHR$(&H1E) OR I$ = "8" OR I$ = "5" THEN ' up-ar "8" "5"
  710. 17090             SJ_CODE& = SEL_BK&(SEL_CSR,0) '表示は頭の方を
  711. 17100             GOSUB *FNT_PUT
  712. 17110         ENDIF
  713. 17120     WEND
  714. 17130     'PRINT
  715. 17140     IF SEL_CSR > 0 THEN
  716. 17150         PRINT
  717. 17160         SEL_OUT& = SEL_BK&(SEL_CSR,SEL_BNK)
  718. 17170     ELSE IF SEL_CSR = 0 THEN
  719. 17180 *SEL_AR2
  720. 17190 ' -- sjisコードで入力 --
  721. 17200         LOCATE 0,CSRLIN '-1
  722. 17210         PRINT CHR$(13)+"                                         "+CHR$(13)+"  コード入力 >";
  723. 17220         LINE INPUT I$
  724. 17230         IF I$ = "" THEN
  725. 17240             LOCATE 0,CSRLIN -1
  726. 17250             PRINT CHR$(13)+"                   "+CHR$(13);
  727. 17260             GOTO *SEL_AR
  728. 17270         ELSE IF LEN(KMID$(I$,1,1)) = 2 THEN
  729. 17280             SEL_OUT& = ASC(MID$(I$,1,1))*256 + ASC(MID$(I$,2,1)) '全角文字の時
  730. 17290         ELSE
  731. 17300             SEL_OUT& = VAL("&h"+I$)                  'sjis coseの時
  732. 17310         ENDIF
  733. 17320 ' -- コードのcheck --
  734. 17330         IF SEL_OUT& < 0 THEN
  735. 17340             GOTO *SEL_AR2
  736. 17350         ELSE IF 255 < SEL_OUT& AND SEL_OUT& < &H8140 THEN
  737. 17360             GOTO *SEL_AR2
  738. 17370         ELSE IF &H9872 < SEL_OUT& THEN
  739. 17380             GOTO *SEL_AR2
  740. 17390         ELSE IF &H8140 <= SEL_OUT& AND SEL_OUT& <= &H9872 THEN
  741. 17400             SEL_OUT& = FNSJADJ&(SEL_OUT&)                  'sjis code の調整
  742. 17410         ELSE 'if 0 <= sel_out& and sel_out& <= 255 then
  743. 17420             '
  744. 17430         ENDIF
  745. 17440     ELSE IF SEL_CODE < 0 THEN
  746. 17450         PRINT "sel_code error"
  747. 17460         STOP
  748. 17470     ENDIF
  749. 17480     RETURN
  750. 17490 '
  751. 17500 '-------------------------- PROGRAM END ------------------------------------------------------
  752.